unit uMergeElmForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uBaseCalcForm, StdCtrls, ExtCtrls, ComCtrls;

type
  TBaseCalcFunc = function(V: array of single): single of object;

  TfmMergeElmCalc = class(TfmBaseCalcForm)
    rgCtype: TRadioGroup;
    rgEtype: TRadioGroup;
    edP1: TLabeledEdit;
    edP2: TLabeledEdit;
    edResult: TLabeledEdit;
    laP1: TLabel;
    laP2: TLabel;
    laResult: TLabel;
    rgCalcType: TRadioGroup;
    btnFind: TButton;
    lvList: TListView;
    procedure rgEtypeClick(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure lvListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure rgCalcTypeClick(Sender: TObject);
    procedure DoPosFloatKeyPress(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DoFieldsChange(Sender: TObject);
  private
    { Private declarations }
    FindFunc: TBaseCalcFunc;
    function calcResParallel(V: array of single): single;
    function calcResSerial(V: array of single): single;
  protected
    function DoCheckFields: boolean; override;
    procedure FieldsChanged; override;
  public
    { Public declarations }
    class function CalcFriendlyName: string; override;
    class function RunKey: string; override;
    class procedure InvokeCalc; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  fmMergeElmCalc: TfmMergeElmCalc;

implementation

{$R *.dfm}

uses uFormReg, uENoms, uLocalization;

type
  TConnectionType = (ctParallel, ctSeries);
  TElementType = (etRes, etCap);
  TCalcType = (cctCalc, cctFind);

const
  // convert input to uF
  sfCmult: array[0..2] of single = (1.0e-6,1.0e-3,1.0);

{ TfmMergeElmCalc }

procedure TfmMergeElmCalc.AfterConstruction;
begin
  inherited;
  LocalizeListColumns(lvList);
  rgEType.Caption := GetLocaleString('etcaption');
  rgCType.Caption := GetLocaleString('ctcaption');
  rgCalcType.Caption := GetLocaleString('calccaption');

  LocalizeStrings(rgEType.Items);
  LocalizeStrings(rgCType.Items);
  LocalizeStrings(rgCalcType.Items);
  btnFind.Caption := Self.GetLocaleString('find');
  rgCalcTypeClick(nil);
  rgEtypeClick(nil);
end;

procedure TfmMergeElmCalc.BeforeDestruction;
begin
  inherited;
end;

class function TfmMergeElmCalc.CalcFriendlyName: string;
begin
  Result := 'Parallel-series element connection';
end;

function TfmMergeElmCalc.DoCheckFields: boolean;
begin
  Result := true;
  if (TCalcType(rgCalcType.ItemIndex)=cctFind) then exit;

  if (AnsiPos(';',edP1.Text)>0) then begin
    Result := true;
    EnableSet('P2', false);
  end else begin
    EnableSet('P2', true);
    Result := CheckErrorField(edP1, StrToValueEx(edP1.Text,0)>0);
  end;
end;

procedure TfmMergeElmCalc.FieldsChanged;
var values: array of single;
    res: single;

    procedure perfCalcResistor();
    begin
      case TConnectionType(rgCType.ItemIndex) of
        ctParallel: begin
            res := calcResParallel(values);
            if (edP2.Enabled) then res := res/StrToIntDef(edP2.Text,1);
          end;
        ctSeries: begin
            res := calcResSerial(values);
            if (edP2.Enabled) then res := res*StrToIntDef(edP2.Text,1);
          end;
      end;
      edResult.Text := FormatValue(res);
    end;

    procedure perfCalcCapacitor();
    begin
      case TConnectionType(rgCType.ItemIndex) of
        ctParallel: begin
            res := calcResSerial(values);
            if (edP2.Enabled) then res := res*StrToIntDef(edP2.Text,1);
          end;
        ctSeries: begin
            res := calcResParallel(values);
            if (edP2.Enabled) then res := res/StrToIntDef(edP2.Text,1);
          end;
      end;
      edResult.Text := FormatValueC(res);
    end;

var s,buf: string;
    tmp: single;
    l: integer;
begin
  if (TCalcType(rgCalcType.ItemIndex)=cctFind) then exit;

  SetLength(values,0);
  l := 0;

  s := Trim(edP1.Text);
  while (s<>'') do begin
    buf := NextToken(s,';');
    tmp := StrToValueEx(buf,0);
    if (tmp>0) then begin
      inc(l);
      SetLength(values, l);
      values[l-1]:= tmp;
    end;
  end;

  case TElementType(rgEType.ItemIndex) of
    etRes: perfCalcResistor();
    etCap: perfCalcCapacitor();
  end;

  SetLength(Values,0);
  //edResult.Text := Format('%.3f', [CheckField(edP1)/CheckField(edP2)]);
end;

class procedure TfmMergeElmCalc.InvokeCalc;
begin
  Application.CreateForm(TfmMergeElmCalc, fmMergeElmCalc);
  inherited;
end;

class function TfmMergeElmCalc.RunKey: string;
begin
  Result := 'psconn';
end;

procedure TfmMergeElmCalc.rgEtypeClick(Sender: TObject);
begin
  inherited;
  SetLabels('P2', GetString('#global\qty'), GetString('#global\pcs'));

  case TElementType(rgEtype.ItemIndex) of
    etRes: begin
        SetLabels('P1', 'R', GetString('#global\ohm'));
        SetLabels('Result', GetLocaleString('result'), GetString('#global\ohm'));
        case TConnectionType(rgCtype.ItemIndex) of
          ctParallel: begin
              FindFunc := calcResParallel;
            end;
          ctSeries: begin
              FindFunc := calcResSerial;
            end;
        end;
      end;
    etCap: begin
        SetLabels('P1', 'C', ''(*GetString('#global\uf')*));
        SetLabels('Result', GetLocaleString('result'), ''(*GetString('#global\uf')*));
        case TConnectionType(rgCtype.ItemIndex) of
          ctParallel: begin
              FindFunc := calcResSerial;
            end;
          ctSeries: begin
              FindFunc := calcResParallel;
            end;
        end;
      end;
  end;
  DoFieldChanged;
end;

function GetOrder(V: single): integer;
begin
  Result := 0;
  if (v<1) then exit;
  repeat
    Inc(Result);
    v := v/10;
  until (v<=1);
end;

procedure TfmMergeElmCalc.btnFindClick(Sender: TObject);
const mult: array[0..13] of single = (0.1,1,10,100,1e3,1e4,1e5,1e6,1e7,1e8,1e9,1e10,1e11,1e12);
var a,b,m1,m2: integer;
    fdata: array[0..2] of single;
    e1,e2,prc: single;
    mxzero: integer;
    ffc: TValueFormatFunc;
begin
  inherited;
  if not DoCheckFields then exit;

  lvList.Items.BeginUpdate;
  try
    lvList.Clear;
    if (@findFunc = nil) then exit;

    fdata[0] := StrToValueEx(edP1.Text, 1.0e-6);

    case TElementType(rgEtype.ItemIndex) of
      etCap: begin
          ffc := @formatValueC;
          fdata[0] := fdata[0]*1.0e12; // pF
        end;
      else ffc := @formatValue;
    end;

    mxzero := GetOrder(fdata[0])+1;
    if (mxzero>high(mult)) then mxzero := high(mult);
    if (TElementType(rgEtype.ItemIndex)=etRes) and (mxzero > 7) then mxzero := 7;

    for m1 := low(mult) to mxzero do begin
      for a := Low(sfE24) to High(sfE24) do begin
        for m2 := low(mult) to mxzero do begin
          for b := Low(sfE24) to High(sfE24) do begin
            e1 := sfE24[a]*mult[m1];
            e2 := sfE24[b]*mult[m2];
            if (e1=fdata[0]) or (e2=fdata[0]) then continue;

            fdata[2] := FindFunc([e1, e2]);

            prc := (fdata[0]-fdata[2])/fdata[0]*100;
            if (abs(prc) < 10) then with lvList.Items.Add do begin

              // FormatValue for C input must be in Farads
              if (TElementType(rgEtype.ItemIndex)=etCap) then begin
                e1 := e1*1.0e-12;
                e2 := e2*1.0e-12;
                fdata[2] := fdata[2]*1.0e-12;
              end;

              if (e2>e1) then begin
                Caption := ffc(e2);
                SubItems.Add(ffc(e1));
              end else begin
                Caption := ffc(e1);
                SubItems.Add(ffc(e2));
              end;
              SubItems.Add(ffc(fdata[2]));
              SubItems.Add(Format('%f', [prc]));
            end;
            if lvList.Items.Count>500 then exit;
          end;
        end;
      end;
    end;
    lvList.AlphaSort;
    RemoveListDupes(lvList);
  finally
    lvList.Items.EndUpdate;
  end;
end;

function TfmMergeElmCalc.calcResParallel(V: array of single): single;
var i: integer;
begin
  Result := 0;
  for i := Low(V) to High(V) do
    if (V[i]>0) then Result := Result+(1/V[i]);
  if (Result>0) then Result := 1/Result;
end;

function TfmMergeElmCalc.calcResSerial(V: array of single): single;
var i: integer;
begin
  Result := 0;
  for i := Low(V) to High(V) do
    Result := Result+V[i];
end;

procedure TfmMergeElmCalc.lvListCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
var a,b: single;
begin
  inherited;
  a := abs(StrToFloatDef(Item1.SubItems[Item1.SubItems.Count-1],0));
  b := abs(StrToFloatDef(Item2.SubItems[Item1.SubItems.Count-1],0));
  if (a<b) then Compare := -1
  else if(a>b) then Compare := 1
  else Compare := 0;
end;

procedure TfmMergeElmCalc.rgCalcTypeClick(Sender: TObject);
begin
  inherited;
  lvList.Clear;
  btnFind.Visible := rgCalcType.ItemIndex=1;
  lvList.Visible := rgCalcType.ItemIndex=1;
  edP2.Visible := rgCalcType.ItemIndex=0;
  laP2.Visible := rgCalcType.ItemIndex=0;
  edResult.Visible := rgCalcType.ItemIndex=0;
  laResult.Visible := rgCalcType.ItemIndex=0;
end;

procedure TfmMergeElmCalc.DoPosFloatKeyPress(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  //
end;

procedure TfmMergeElmCalc.DoFieldsChange(Sender: TObject);
begin
  inherited;
  DoFieldChanged;
end;

initialization
  RegisterCalc(TfmMergeElmCalc);

end.
